home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / barmenu.bas < prev    next >
BASIC Source File  |  1986-10-22  |  2KB  |  82 lines
  1. ' $dynamic
  2.  
  3. defint a-z
  4.  
  5. ' sample program
  6.  
  7. dim menudata$(3)
  8.  
  9. menudata$(0) = "Go"
  10. menudata$(1) = "Previous"
  11. menudata$(2) = "Next"
  12. menudata$(3) = "Quit"
  13. color 15,1,1
  14. cls
  15. call barmenu (25,5,10,14,1,menudata$(),option$)
  16. cls
  17. print option$;
  18. end
  19.  
  20. ' meat of routine
  21.  
  22. sub barmenu (y,x,spacing,tc,bc,prompts$(1),return$) static
  23.  
  24.     top = lbound(prompts$)
  25.     bottom = ubound(prompts$)
  26.     redim position(bottom)
  27.     okprompt$ = ""
  28.     locate y,x,0
  29.     color tc,bc
  30.     for i = top to bottom
  31.         position (i) = pos(y)
  32.         print prompts$(i); spc(spacing);
  33.         okprompt$ = okprompt$ + chr$(asc(prompts$(i)))
  34.     next i
  35.     current = top
  36.     moveto = current
  37.     return$ = ""
  38.     while return$ = ""
  39.        color bc,tc
  40.        locate y,position(current)
  41.        print prompts$(current);
  42.        while ch$ = ""
  43.           ch$ = inkey$
  44.        wend
  45.        if asc(ch$) = 0 then
  46.           call specialkey(ch$,moveto,top,bottom)
  47.        elseif ch$ = chr$(13) then
  48.           return$ = chr$(asc(prompts$(current)))
  49.        elseif instr(okprompt$,ch$) > 0 then
  50.           return$ = ch$
  51.        else
  52.           beep
  53.        end if
  54.        if moveto <> current then
  55.           color tc,bc
  56.           locate y,position(current)
  57.           print prompts$(current);
  58.           current = moveto
  59.        end if
  60.        ch$ = ""
  61.     wend
  62.     erase position
  63. end sub
  64.  
  65. sub specialkey(ch$,where,low,high) static
  66.  
  67.     c = asc(right$(ch$,1))
  68.     if c = 71 then
  69.         where = low
  70.     elseif c = 79 then
  71.         where = high
  72.     elseif c = 75 then
  73.         where = where -1
  74.     elseif c = 77 then
  75.         where = where + 1
  76.     else
  77.         beep
  78.     end if
  79.     if where < low then where = high
  80.     if where > high then where = low
  81. end sub
  82.